Delphi Informant Complete 1995 - 2000/Delphi Informant Complete 1995 to 2000.iso/Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar/1998/Jul/di9807jp/SFTPCLIENT/CMsgThrd.pas

Pascal/Delphi Source File | 1998-02-20 | 11KB | 410 lines

(*
 Message Thread unit developed for Delphi Informant article by John Penman, 23 January 1998
 SFTP Client message thread
*)

unit CMsgThrd;

interface

uses
 Classes, extctrls, Windows, Winsock2;

type

// Simple state machine
  TStates = (stMsg, stData, stError, stDead);

// Info from the main form

  TRequest = record
              Password,
              Port,
              UserName,
              FileName,
              MachineName,
              HostName : String;
             end;

// Event record

  TConnData = record
               NumEvents : DWORD;
               EventArray : array[1..WSA_MAXIMUM_WAIT_EVENTS] of WSAEvent;
              end;

// The Message thread class

  TMsgThrd = class(TThread)
  private
    { Private declarations }
  protected
    EventMsg,
    EventData              : WSAEVENT;
    Done                   : Boolean;
    lpNetworkEvents        : PWSANETWORKEVENTS;
    ConnData               : TConnData;
    wsaData                : TWSADATA;
    Host                   : PHostent;
    CurrentIPAddr,
    DataFileName,
    Msg,
    OldMsgPort             : String;
    sktData,
    sktMsg                 : TSocket;
    h_addr                 : pchar;
    ClientAddr, HostAddr   : TSockAddrIn;
    Buffers                : array[0..MAXGETHOSTSTRUCT-1] of char;
    Request                : TRequest;
    ResTimer               : TTimer;
    TimeOutValue           : Integer;
    RequestMsg             : String;
    procedure Execute; override;
    procedure Update;
    procedure EnableBtn;
    procedure Resolve;
    procedure SendMsg(Msg : String);
    procedure HandleSocketEvent;
    procedure OnMsgThrdDone(Sender : TObject);
    procedure OnTimeOut(Sender : TObject);
  public
    Finished : Boolean;
    constructor Create(Requests : TRequest; TimerSetting : Integer);
  end;

var
  State : TStates;

implementation

uses CDataThrd, Dialogs, Main, SysUtils;

{ TMsgThrd }

procedure TMsgThrd.Update;
begin
 frmMain.memStatusMsg.Lines.Add(Msg);
end;

procedure TMsgThrd.EnableBtn;
begin
 frmMain.bbtnGetFile.Enabled := TRUE;
end;

procedure TMsgThrd.Resolve;
begin
// Resolve hostname
  Host := gethostbyname(pchar(Request.HostName));
  if Host = NIL then
  begin
   Msg := Concat('Failed to find host ',Request.HostName);
   Synchronize(Update);
   Synchronize(EnableBtn);
   State := stError;
   Done := TRUE;
   Exit;
  end;
  Msg := Concat('Host ' + frmMain.edHostname.Text, ' found...');
  Synchronize(Update);
  Move(Host^.h_addr_list^, h_addr, SizeOf(Host^.h_addr_list^));
  with HostAddr.sin_addr do
  begin
   S_un_b.s_b1 := h_addr[0];
   S_un_b.s_b2 := h_addr[1];
   S_un_b.s_b3 := h_addr[2];
   S_un_b.s_b4 := h_addr[3];
  end;
  HostAddr.sin_family := AF_INET;
  HostAddr.sin_port   := htons(MsgPort);
// We got this far, so we send a message ...
  SendMsg(RequestMsg);
end;


procedure TMsgThrd.SendMsg(Msg : String);
var
 Buff : PWSABUF;
 BuffCount,
 Flags,
 Len,
 Res,
 NoBytesSent : Integer;
begin
  Len := SizeOf(HostAddr);
  Buff := NIL;
  try
   Buff := AllocMem(SizeOf(Buffers));
   Buff.Buf := Buffers;
   Buff.Buf := PChar(Msg);
   Buff.Len := SizeOf(Buffers);
   Flags := 0;
   BuffCount := 1;
   ResTimer.Enabled  := TRUE;

// Send the message ...

   Res := WSASendTo(sktMsg, Buff, BuffCount, @NoBytesSent, Flags, @HostAddr, Len, NIL, NIL);
   if Res = SOCKET_ERROR then
   begin
    Msg := Concat('Failed to send.  Error ', IntToStr(WSAGetLastError));
    Freemem(Buff, SizeOf(Buffers));
    Synchronize(Update);
    State := stError;
    Done := TRUE;
    Exit;
   end;
  finally
   Freemem(Buff, SizeOf(Buffers));
  end;
end;

procedure TMsgThrd.HandleSocketEvent;
var
 Res : Integer;
 Buff : PWSABUF;
 Flags, NoBytes,
 Size, AddrStrSize, Error : Integer;
 AddrStr : PChar;
begin
 if State = stError then
  Exit;
 Flags := 0;
 Res := WSAEnumNetworkEvents(sktMsg, EventMsg, @Buffers[0]);
 if Res = SOCKET_ERROR then
 begin
  Msg := Concat('Call to WSAEnumNetworkEvents failed. Error ', IntToStr(WSAGetLastError));
  Synchronize(Update);
  Done := TRUE;
  Exit;
 end;
 lpNetworkEvents := PWSANETWORKEVENTS(@Buffers[0]);
// Decipher Network events...
 with lpNetworkEvents^ do
 begin
// Is this a FD_READ event?
  if (lNetworkEvents and FD_READ) = FD_READ then
  begin
   if iErrorCode[1] = WSAENETDOWN then
   begin
    Msg := 'Network down...';
    Synchronize(Update);
   end;
   Size := SizeOf(HostAddr);
   Msg := 'FD_READ...';
   Synchronize(Update);
   Buff := NIL;// This is a dummy to avoid the warning message from the compiler
   try
    Buff := AllocMem(SizeOf(Buffers));
    Buff.Buf := Buffers;
    Buff.len := SizeOf(Buffers);
    Res := WSARecvFrom(sktMsg, Buff, 1, @NoBytes, @Flags,
                       @HostAddr, @Size, NIL, NIL);
    if Res = SOCKET_ERROR then
    begin
     Error := WSAGetLastError;
     if Error <> WSAEWOULDBLOCK then
     begin
      Msg := Concat('Call to WSARecvFrom failed. Error ',IntToStr(Error));
      Synchronize(Update);
      Done := TRUE;
      Exit;
     end;
    end else
    begin
     if State = stMsg then
     begin
      Msg := Concat('Message : ', String(Buff.Buf));
      Synchronize(Update);
      AddrStr := NIL;
      try
       AddrStr := StrAlloc(MAXGETHOSTSTRUCT);
       AddrStrSize := MAXGETHOSTSTRUCT;
       Res := WSAAddressToString(@HostAddr, SizeOf(HostAddr), NIL, AddrStr, @AddrStrSize);
       if Res = SOCKET_ERROR then
       begin
        Msg := Concat('Call to WSAAddressToString failed. Error ', IntToStr(WSAGetLastError));
        Synchronize(Update);
       end;
       Msg := Concat('Message from host ', String(AddrStr));
       Synchronize(Update);
       CurrentIPAddr := copy(String(AddrStr), 1, Pos(':', String(AddrStr))-1);
      finally
       StrDispose(AddrStr);
      end;
// Parse message from the host
      Msg := String(Buff.buf);
      Synchronize(Update);
      if Pos('OK',UpperCase(String(Buff.Buf))) > 0 then
      begin // Okay, set up port for listening
       Msg := 'Now setting up port for data transfer...';
       Synchronize(Update);
       State := stData;
       thrdData := TDataThrd.Create(StrToInt(Request.Port), Request.FileName);
       Done := TRUE;
      end else
      begin
// Any other response is an error, so handle it gracefully
       Msg := 'Error. Cannot retrieve file.';
       Synchronize(Update);
       State := stError;
       Synchronize(EnableBtn);
       Done := TRUE;
      end;
     end;
     if State = stData then
     begin
      Msg := 'Transferring data...';
      Synchronize(Update);
     end;
    end;
   finally
    FreeMem(Buff);
   end;
  end;
// Is this a FD_WRITE event?
  if (lNetworkEvents and FD_WRITE) = FD_WRITE then
  begin
   if iErrorCode[2] = WSAENETDOWN then
   begin
    Msg := 'Network down...';
    Synchronize(Update);
   end else
   begin
    Msg := 'FD_WRITE...';
    Synchronize(Update);
   end;
  end;
 end;
end;

constructor TMsgThrd.Create(Requests : TRequest; TimerSetting : Integer);
var
 Res        : Integer;
begin
 inherited Create(TRUE);
 FreeOnTerminate   := TRUE;
 OnTerminate       := OnMsgThrdDone;
 TimeOutValue      := TimerSetting;
 Done              := FALSE;
// Set the Timer ...
 ResTimer          := TTimer.Create(NIL);
 ResTimer.Interval := TimeOutValue;
 ResTimer.OnTimer  := OnTimeOut;
 ResTimer.Enabled  := FALSE;
// Decode Request record to build the request message ...
 Request := Requests;
 with Request do
 begin
  RequestMsg := ConCat(UserName,':',Password,':',
                       MachineName,':',Port,':',FileName);
 end;
 State := stMsg;
// Set up the message socket ...
 sktMsg := WSASocket(AF_INET, SOCK_DGRAM, IPPROTO_UDP, NIL, 0, 0);
 if sktMsg = SOCKET_ERROR then
 begin
  Msg := Concat('Failed to create socket Error ', IntToStr(WSAGetLastError));
  Synchronize(Update);
  State := stError;
  Done := TRUE;
  Exit;
 end; // AllocMem
// Creates events ...
 EventMsg := CreateEvent(NIL,